home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1989 May / 1989-05.d64 / knock 31 (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  8KB  |  201 lines
  1. 10 rem copyright 1989 compute! publications, inc. - all rights reserved
  2. 20 print"[147][144]"tab(12)"copyright 1989"
  3. 30 printtab(7)"compute! publications, inc."
  4. 40 poke53287,0
  5. 50 printtab(10)"all rights reserved"
  6. 60 fortt=0to3000:next
  7. 70 gosub1740:gosub1490:gosub1640
  8. 80 gosub1210:kn=0:tn=0
  9. 90 printleft$(cd$,vt(dl)+1)tab(21+(dl=1ordl=4)*9)"dealer"
  10. 100 tn=tn+1:forl=1to4
  11. 110 onpugosub150,420,420,420:printcd$"                              "
  12. 120 pu=pu+1+(pu>4-1)*4:ifkn<>puanddp<52thennext:goto100
  13. 130 gosub720:dl=dl+1+(dl>4-1)*4:goto80
  14. 140 rem======== p l a y e r ============
  15. 150 ifpt(1)<1thenreturn
  16. 160 pokesh,152:pokesv,154:pokesp,1:t1=1:t2=152:t3=48:t4=154:wc=3
  17. 170 printcd$"  choose from discards or deck":gosub320
  18. 180 ifmvthen200
  19. 190 dp=dp+1:uc=dp:printleft$(cd$,12)tab(21);:c3=dk(dp,3):c4=dk(dp,1):gosub1420
  20. 200 pokesh,40:pokesv,114:t1=2:t2=40:t3=24:t4=114
  21. 210 printcd$"     choose card to discard   ":gosub320
  22. 220 ifup=0then270
  23. 230 printleft$(cd$,12)tab(21);:c3=dk(hn(1,mv+1),3):c4=dk(hn(1,mv+1),1)
  24. 240 gosub1420
  25. 250 wc=mv+1:printleft$(cd$,7)tab(mv*3+1);:c3=dk(uc,3):c4=dk(uc,1):gosub1420
  26. 260 t=uc:uc=hn(1,mv+1):hn(1,mv+1)=t
  27. 270 pokesp,0:ifknthen300
  28. 280 printcd$"  do you want to knock?  [y/n]":gosub1010:gosub390
  29. 290 ifq$="y"orjs=30thenprintleft$(cd$,8)tab(12)"knock!":kn=1:kt=tn:gosub1070
  30. 300 return
  31. 310 rem======== c h o o s e ============
  32. 320 mv=0:up=1:poke198,0:gosub1010
  33. 330 gosub390:forl1=1to99:next:ifq$=chr$(13)orjs=15thenreturn
  34. 340 ifq$="^"orjs=23thenmv=mv+1:ifmv>t1thenmv=0
  35. 350 ifq$="*"orjs=27thenmv=mv-1:ifmv<0thenmv=t1
  36. 360 ifq$="="orjs=29thenpokesh,200:pokesv,154:up=0:mv=1:goto330
  37. 370 up=1:pokesh,t2+mv*t3:pokesv,t4:goto330
  38. 380 rem========= i n p u t =============
  39. 390 getq$:js=peek(56320)and31:ifq$=""andjs=31then390
  40. 400 wait56320,16,15:return
  41. 410 rem====== c o m p u t e r ==========
  42. 420 ifpt(pu)<1thensc(pu)=0:return
  43. 430 gosub650
  44. 440 if(dk(uc,2)<5orkn)andsc(pu)<21+(pl=2)then490
  45. 450 t=99:xc=lc:forl1=1to4
  46. 460 ifdk(hn(pu,l1),3)<>csthenxc=l1
  47. 470 next
  48. 480 ifxc<4thenprintcd$"     "pl$(pu)" takes the discard  ":gosub1040:goto550
  49. 490 dp=dp+1:uc=dp:printcd$"    "pl$(pu)" picks from the deck  "
  50. 500 gosub1040:gosub650
  51. 510 t=99:xc=lc:forl1=1to4
  52. 520 ifdk(hn(pu,l1),3)<>csthenxc=l1
  53. 530 next:ifxc<4then550
  54. 540 printleft$(cd$,12)tab(21);:c3=dk(uc,3):c4=dk(uc,1):wc=3:gosub1420:goto580
  55. 550 printleft$(cd$,12)tab(21);:c3=dk(hn(pu,xc),3):c4=dk(hn(pu,xc),1):wc=3
  56. 560 gosub1420
  57. 570 t=uc:uc=hn(pu,xc):hn(pu,xc)=t
  58. 580 t=21-(tn>2)*1+-(tn>4)*1+-(tn>6)*1+(pl=2):ifpt(1)>0then610
  59. 590 forl1=1to3:printleft$(cd$,vt(pu))tab(ht(pu)+(l1*3-3));
  60. 600 c3=dk(hn(pu,l1),3):c4=dk(hn(pu,l1),1):wc=l1:gosub1420:next
  61. 610 ifkn<>0orcc<tthen630
  62. 620 kn=pu:kt=tn:printleft$(cd$,vt(pu)+1)tab(21+(pu=4)*9)"knock!":gosub1070
  63. 630 forl1=1to2000:next:return
  64. 640 rem========= s c o r e =============
  65. 650 cc=0:hn(pu,4)=uc
  66. 660 forl1=1to4:forl2=1to4
  67. 670 t=0:forl3=1to4:ifl2=l3then690
  68. 680 ifdk(hn(pu,l3),3)=l1thent=t+dk(hn(pu,l3),2)
  69. 690 next:ift>ccthencc=t:cs=l1:lc=l2:sc(pu)=cc
  70. 700 next:next:return
  71. 710 rem========= k n o c k =============
  72. 720 poke198,0
  73. 730 ifdp=52thenprintcd$"         no more cards!":gosub1040
  74. 740 pu=1:sc(1)=0:uc=0:gosub650:sc(1)=cc
  75. 750 t=0:t1=0:t2=0:forl1=1to4:ifpt(l1)<1then810
  76. 760 printleft$(cd$,vt(l1)+3)tab(23+(l1=1orl1=4)*11)""sc(l1):gosub1010
  77. 770 ifl1<>knthenifsc(l1)=>sc(kn)thent=t+1:ifsc(l1)>t1thent1=sc(l1)
  78. 780 forl2=1to3
  79. 790 printleft$(cd$,vt(l1))tab(ht(l1)+(l2*3-3));
  80. 800 c3=dk(hn(l1,l2),3):c4=dk(hn(l1,l2),1):wc=l2:gosub1420:next
  81. 810 next
  82. 820 ifdp=52thenprintcd$"  hands dumped -- no winners  ":gosub1040:goto920
  83. 830 ift=0then860
  84. 840 printcd$"      "pl$(kn)" lost two points    ":pt(kn)=pt(kn)-2
  85. 850 printleft$(cd$,vt(kn)-2)tab(ht(kn)+6)-(pt(kn)=>0)*pt(kn);:gosub1040:goto920
  86. 860 t=1:ifkt=1orsc(kn)=31thent=2
  87. 870 ift=1thenprintcd$"       "pl$(kn)" won the round     "
  88. 880 ift>1thenprintcd$"    "pl$(kn)" won a double round!  "
  89. 890 gosub1040:forl1=1to4:pt(l1)=pt(l1)+(l1<>kn)*t:ifl1=knorpl(l1)=-1then910
  90. 900 printleft$(cd$,vt(l1)-2)tab(ht(l1)+6)-(pt(l1)=>0)*pt(l1);
  91. 910 next
  92. 920 pl=4:forl1=1to4:pl=pl+(pt(l1)<1):pl(l1)=(pt(l1)<1):next
  93. 930 forl1=1to3000:next:gosub1010
  94. 940 ifpl=1thenprintcd$"   game over -- press any key ":gosub390:run
  95. 950 ifpt(1)>0then980
  96. 960 printcd$"   do you want to watch? [y/n]":gosub390
  97. 970 on-(q$="y"orjs=30)goto990:run
  98. 980 printcd$"    press any key to continue ":gosub390
  99. 990 return
  100. 1000 rem========== b e e p ==============
  101. 1010 pokesr,240:pokewv,17:pokehf,50:pokelf,35:pokeat,0
  102. 1020 fors1=1to99:next:pokewv,16:pokesr,0:return
  103. 1030 rem========== b o o p ==============
  104. 1040 pokevl,15:pokeat,0:pokesr,225:pokewv,17:pokehf,33:pokelf,33
  105. 1050 fors1=1to99:next:pokewv,16:return
  106. 1060 rem========= k n o c k =============
  107. 1070 fors1=1to3:pokesr,10:pokewv,129:pokehf,30:pokeat,3
  108. 1080 fors2=1to250:next:pokewv,128:next:return
  109. 1090 rem======= s h u f f l e ===========
  110. 1100 printcd$"       shuffling the deck     ":gosub1040
  111. 1110 ifrd(1)=0thenforl=1to52:rd(l)=l:next
  112. 1120 forl=1to52:t=int(rnd(1)*52+1)
  113. 1130 t1=rd(l):rd(l)=rd(t):rd(t)=t1:next
  114. 1140 forl=1to52
  115. 1150 dk(l,1)=rd(l)-13*int((rd(l)-1)/13)
  116. 1160 dk(l,2)=-(dk(l,1)>9)*10-(dk(l,1)=1)*11:ifdk(l,2)=0thendk(l,2)=dk(l,1)
  117. 1170 dk(l,3)=int((rd(l))/13+.99)
  118. 1180 next
  119. 1190 return
  120. 1200 rem========== d e a l ==============
  121. 1210 gosub1100:sys900:rd=rnd(-ti)
  122. 1220 t=dl:ifpt(dl)<1thendl=dl+1+(dl>4-1)*4:goto1220
  123. 1230 forl1=1to4:ifpt(l1)<1then1290
  124. 1240 printleft$(cd$,vt(l1)-3)tab(ht(l1))"[164][164][164][164][164][164][164][164]"
  125. 1250 printtab(ht(l1))"[144]"left$(pl$(l1)+"  ",5)" [149]"right$(str$(pt(l1)),2)
  126. 1260 printtab(ht(l1))"[165][129][185][185][180][129][185][185][165][129][185][185][185][167]"
  127. 1270 forl2=1to3:printtab(ht(l1))"[165][129]  [146][180][129]  [146][165][129]   [146][167]":next
  128. 1280 printtab(ht(l1))"[165][129][184][184][180][129][184][184][165][129][184][184][184][170]"
  129. 1290 next
  130. 1300 printleft$(cd$,12)tab(14)"[165][129][185][185][185][167]    [165]"cr$"[146][165][129]   [146][167]    [165]"cr$"[146][165]";
  131. 1310 print"[129]   [146][167]    [165]"cr$"[146][165][129]   [146][167]    [165]"cr$"[146][165][129][184][184][184][167]    [165]"
  132. 1320 forl1=1to4:forl2=1to3:hn(l1,l2)=0:next:next
  133. 1330 dp=0:forl1=1to3:forl2=1to4
  134. 1340 t=t+1+(t>4-1)*4:ifpt(t)<1then1380
  135. 1350 dp=dp+1:hn(t,l1)=dp:ift>1andpt(1)>0then1380
  136. 1360 printleft$(cd$,vt(t))tab(ht(t)+(l1*3-3));:c3=dk(dp,3):c4=dk(dp,1):wc=l1
  137. 1370 gosub1420
  138. 1380 next:next:dp=dp+1:uc=dp
  139. 1390 printleft$(cd$,12)tab(21);:c3=dk(dp,3):c4=dk(dp,1):gosub1420
  140. 1400 pu=t+1+(t>4-1)*4:return
  141. 1410 rem== d i s p l a y   c a r d ======
  142. 1420 ifwc<3then1450
  143. 1430 t$="[165][146][157][157][157][157][157]"+co$(c3):print"[146]"co$(c3)c1$(c4)"  "t$su$(c3)"   ";
  144. 1440 printt$"    "t$"   "su$(c3)t$"  "c2$(c4)t$"":return
  145. 1450 t$="[157][157][157]"
  146. 1460 print"[146]"co$(c3)c1$(c4)"[167]"t$co$(c3)su$(c3)" [167]"t$"  [167]"t$"  [167]"t$"  [167]"
  147. 1470 return
  148. 1480 rem======= o p t i o n s ===========
  149. 1490 poke53281,15:poke53280,6
  150. 1500 print"[147][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][146][164][164][164] k n o c k    ";
  151. 1510 print"t h i r t y   o n e [146][164][164][164][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][157][148][183]
  152. 1520 [153]cd$"oncmdcmdcmdcmd   ortantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantan^  cmdsave "
  153. 1530 [153]"   (NULL)"[163]36)"(NULL)      /tantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantanexp  cmdsave "
  154. 1540 [158]900
  155. 1550 [153]cd$"     starting points   [10]     ":[141]1010:t[178]10
  156. 1560 [141]390:[139]q$[178][199](13)[176]js[178]15[167]1600
  157. 1570 [139]q$[178]"\"[176]js[178]30[167]t[178]t[170]5:[139]t[177]25[167]t[178]5
  158. 1580 [139]q$[178]"="[176]js[178]29[167]t[178]t[171]5:[139]t[179]5[167]t[178]25
  159. 1590 [153]cd$[163]28)""[201]([196](t),2)"":[137]1560
  160. 1600 [129]l[178]1[164]4:pt(l)[178]t:[153][200](cd$,vt(l)[171]3)[163]ht